Attribute VB_Name = "System"
Option Explicit
Declare Function GetTick Lib "kernel32" Alias "GetTickCount" () As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Draw As New DrawClass
Public Terrain As DirectDrawSurface7
Public Sprites As DirectDrawSurface7
Public Spells As DirectDrawSurface7
Public Items As DirectDrawSurface7
Public Run As Boolean



'Game stuff
Public Type Chunk_Type
X As Integer
Y As Integer
Grid(50, 50) As Byte
End Type
Public Chunk() As Chunk_Type
Public Grid As New GridClass
Public FireGrid(100, 100) As Long


Public CamX As Single
Public CamY As Single
Public CamTarget As String
Public Dir As Byte
Public LastDir As Byte
Public Plr As String
Public EntityMgr As New EntiyManagerClass



Public Sub Main()
Dim i As Integer
Draw.SetWindow (MainFrm.View.hwnd)
Draw.SetSize 640, 640
Plr = EntityMgr.AddPlayer("Rott")
EntityMgr.Entities(Plr).X = 50: EntityMgr.Entities(Plr).Y = 50
CamTarget = Plr
LastDir = 2

Dim TempCK As DDCOLORKEY
Dim TerrainDesc As DDSURFACEDESC2: Dim SpritesDesc As DDSURFACEDESC2: Dim SpellsDesc As DDSURFACEDESC2: Dim ItemsDesc As DDSURFACEDESC2
TerrainDesc.lFlags = DDSD_CAPS
TerrainDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set Terrain = Draw.DD.CreateSurfaceFromFile(App.Path & "\tiles0.bmp", TerrainDesc)
TempCK.low = RGB(150, 138, 84): TempCK.high = RGB(150, 138, 84)
Terrain.SetColorKey DDCKEY_SRCBLT, TempCK

SpritesDesc.lFlags = DDSD_CAPS
SpritesDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set Sprites = Draw.DD.CreateSurfaceFromFile(App.Path & "\Sprites.bmp", SpritesDesc)
TempCK.low = 0: TempCK.high = 0
Sprites.SetColorKey DDCKEY_SRCBLT, TempCK

SpellsDesc.lFlags = DDSD_CAPS
SpellsDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set Spells = Draw.DD.CreateSurfaceFromFile(App.Path & "\Spells.bmp", SpellsDesc)
TempCK.low = 0: TempCK.high = 0
Spells.SetColorKey DDCKEY_SRCBLT, TempCK

ItemsDesc.lFlags = DDSD_CAPS
ItemsDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set Items = Draw.DD.CreateSurfaceFromFile(App.Path & "\items.bmp", ItemsDesc)
TempCK.low = 0: TempCK.high = 0
Items.SetColorKey DDCKEY_SRCBLT, TempCK



Dir = 255
MainFrm.Show
Call GameLoop
End Sub

Public Sub ClipRect(ByRef DestRect As RECT, ByRef SrcRect As RECT)
Dim View As RECT
Dim DestWidth As Long
Dim DestHeight As Long


With DestRect

If .Top < 0 Then
SrcRect.Top = SrcRect.Top + Abs(.Top): .Top = .Top + Abs(.Top): End If

If .Left < 0 Then
SrcRect.Left = SrcRect.Left + Abs(.Left): .Left = .Left + Abs(.Left): End If

If .Bottom > 640 Then
SrcRect.Bottom = SrcRect.Bottom - Abs((.Bottom - 640)): .Bottom = .Bottom - Abs(.Bottom - 640): End If

If .Right > 640 Then
SrcRect.Right = SrcRect.Right - Abs((.Right - 640)): .Right = .Right - Abs(.Right - 640): End If

End With
End Sub

Private Sub Railstuff()
'puttingi stuff here do I don't gotta comment this shit
'If (Grid(AX + 1, AY) >= 6 Or Grid(AX - 1, AY) >= 6) And (Grid(AX, AY - 1) < 6 And Grid(AX, AY + 1) < 6) Then
'Grid(AX, AY) = 6
'End If
'If (Grid(AX, AY - 1) >= 6 Or Grid(AX, AY + 1) >= 6) And (Grid(AX - 1, AY) < 6 And Grid(AX + 1, AY) < 6) Then
'Grid(AX, AY) = 7
'End If
'curves
'If (Grid(AX + 1, AY) >= 6 And Grid(AX, AY + 1) >= 6) And (Grid(AX - 1, AY) < 6 And Grid(AX + 1, AY - 1) < 6) Then
'Grid(AX, AY) = 8
'End If
'If (Grid(AX, AY - 1) >= 6 And Grid(AX + 1, AY) >= 6) And (Grid(AX, AY + 1) < 6 And Grid(AX - 1, AY) < 6) Then
'Grid(AX, AY) = 9
'End If
'If (Grid(AX - 1, AY) >= 6 And Grid(AX, AY - 1) >= 6) And (Grid(AX + 1, AY) < 6 And Grid(AX, AY + 1) < 6) Then
'Grid(AX, AY) = 10
'End If
'If (Grid(AX - 1, AY) >= 6 And Grid(AX, AY + 1) >= 6) And (Grid(AX + 1, AY) < 6 And Grid(AX, AY - 1) < 6) Then
'Grid(AX, AY) = 11
'End If
'cross
'If (Grid(AX - 1, AY) >= 6 And Grid(AX + 1, AY) >= 6) And (Grid(AX, AY - 1) >= 6 And Grid(AX, AY + 1) >= 6) Then
'Grid(AX, AY) = 12
'End If
End Sub

Public Sub GameLoop()
    Dim Y As Integer
    Dim X As Integer
    Dim i As Integer
    Dim n As Integer
    Dim RenderTick As Long
    Dim MoveTick As Long
    Dim InputTick As Long
    Dim FireTick As Long
    Dim UpdateTick As Long
    Run = True

    Do Until Run = False

        Call RenderScene

        If Abs(GetTick - InputTick) >= 33 Then
            Dir = 0
            If GetAsyncKeyState(vbKeyRight) <> 0 Then Dir = (2 ^ 0)
            If GetAsyncKeyState(vbKeyDown) <> 0 Then Dir = (2 ^ 1)
            If GetAsyncKeyState(vbKeyLeft) <> 0 Then Dir = (2 ^ 2)
            If GetAsyncKeyState(vbKeyUp) <> 0 Then Dir = (2 ^ 3)
            If Dir > 0 Then LastDir = Dir
            InputTick = GetTick
        End If
        
        
        If Abs(GetTick - UpdateTick) >= 1000 Then
        Call EntityMgr.UpdateEntities
        UpdateTick = GetTick
        End If

        If Abs(GetTick - MoveTick) >= 50 Then
        
        If LenB(CamTarget) Then
        With EntityMgr.Entities(CamTarget)
        If Dir > 0 Then
        If Dir And (2 ^ 0) Then If .X < 100 Then If Grid.GetTile(Round(.X + 0.2), Round(.Y)) <> 3 Then .X = .X + 0.3
        If Dir And (2 ^ 1) Then If .Y < 100 Then If Grid.GetTile(Round(.X), Round(.Y + 0.2)) <> 3 Then .Y = .Y + 0.3
        If Dir And (2 ^ 2) Then If .X > 0 Then If Grid.GetTile(Round(.X - 0.2), Round(.Y)) <> 3 Then .X = .X - 0.3
        If Dir And (2 ^ 3) Then If .Y > 0 Then If Grid.GetTile(Round(.X), Round(.Y - 0.2)) <> 3 Then .Y = .Y - 0.3
        End If
        CamX = (.X - (.X - CamX) * 0.9): CamY = (.Y - (.Y - CamY) * 0.9)
        'CamX = CamX + ((Rnd * 32) - 64): CamY = CamY + ((Rnd * 32) - 64)
        End With
        End If
        MoveTick = GetTick
        End If
        
        
        If Abs(GetTick - FireTick) >= 1000 Then
        Dim TempFire(100, 100) As Long
        
        
        For Y = 0 To 100
        For X = 0 To 100
        
        If FireGrid(X, Y) > 0 Then
        Dim r As Long: r = Abs(GetTick - FireGrid(X, Y))
        If r > 3000 Then FireGrid(X, Y) = 0: Grid.SetTile(X, Y) = 5
        End If
        
        TempFire(X, Y) = FireGrid(X, Y)
        Next
        Next
        
        For Y = 0 To 100
        For X = 0 To 100

        If FireGrid(X, Y) > 0 Then
        
        If X - 1 > 0 And Y - 1 > 0 Then If Grid.GetTile(X - 1, Y - 1) = 3 And FireGrid(X - 1, Y - 1) = 0 Then TempFire(X - 1, Y - 1) = GetTick
        If Y - 1 > 0 Then If Grid.GetTile(X, Y - 1) = 3 And FireGrid(X, Y - 1) = 0 Then TempFire(X, Y - 1) = GetTick
        If X + 1 < 100 And Y - 1 > 0 Then If Grid.GetTile(X + 1, Y - 1) = 3 And FireGrid(X + 1, Y - 1) = 0 Then TempFire(X + 1, Y - 1) = GetTick
        If X - 1 > 0 Then If Grid.GetTile(X - 1, Y) = 3 And FireGrid(X - 1, Y) = 0 Then TempFire(X - 1, Y) = GetTick
        If X + 1 < 100 Then If Grid.GetTile(X + 1, Y) = 3 And FireGrid(X + 1, Y) = 0 Then TempFire(X + 1, Y) = GetTick
        If X - 1 > 0 And Y + 1 < 100 Then If Grid.GetTile(X - 1, Y + 1) = 3 And FireGrid(X - 1, Y + 1) = 0 Then TempFire(X - 1, Y + 1) = GetTick
        If Y + 1 < 100 Then If Grid.GetTile(X, Y + 1) = 3 And FireGrid(X, Y + 1) = 0 Then TempFire(X, Y + 1) = GetTick
        If X + 1 < 100 And Y + 1 < 100 Then If Grid.GetTile(X + 1, Y + 1) = 3 And FireGrid(X + 1, Y + 1) = 0 Then TempFire(X + 1, Y + 1) = GetTick
        End If

        Next
        Next
        
        For Y = 0 To 100
        For X = 0 To 100
        If TempFire(X, Y) > 0 Then
        FireGrid(X, Y) = TempFire(X, Y)
        End If
        Next
        Next
        
            FireTick = GetTick
        End If
        

        

        DoEvents
    Loop

End Sub

Public Function WithinBounds(ByVal X As Integer, ByVal Y As Integer) As Boolean
If X >= 0 And Y >= 0 And X <= 100 And Y <= 100 Then
WithinBounds = True
Exit Function
End If
WithinBounds = False
End Function

Public Sub Render32(ByVal X As Long, ByVal Y As Long, ByVal SX As Long, ByVal SY As Long, Surface As DirectDrawSurface7)
Dim NRect As RECT
Dim SrcRect As RECT
With NRect
.Left = X
.Top = Y
.Right = .Left + 32
.Bottom = .Top + 32
End With
With SrcRect
.Left = SX * 32
.Top = SY * 32
.Right = .Left + 32
.Bottom = .Top + 32
End With
Call ClipRect(NRect, SrcRect)
Call Draw.Surf.Blt(NRect, Surface, SrcRect, DDBLTFAST_WAIT Or DDBLT_KEYSRC)
End Sub



Public Sub RenderScene()
    Dim Y As Integer
    Dim X As Integer
    Dim AY As Long
    Dim AX As Long
    Dim TY As Long
    Dim TX As Long
    
    Dim i As Integer
    Dim n As Integer
    Dim NRect As RECT
    Dim SrcRect As RECT
    Call Draw.Clear(&HFFFFFF)
    Dim XOffSet, YOffSet As Single: XOffSet = CamX - Round(CamX): YOffSet = CamY - Round(CamY)

    'base terrain
    For Y = 0 To 22
        For X = 0 To 22
        AX = Round(CamX) + (X - 11): AY = Round(CamY) + (Y - 11)
        TX = ((X - 1) - XOffSet) * 32: TY = ((Y - 1) - YOffSet) * 32

            If WithinBounds(Round(CamX) + (X - 11), Round(CamY) + (Y - 11)) Then
              Select Case Grid.GetTile(AX, AY)
              Case Is <= 2
                Call Render32(TX, TY, 4, 24 + (Grid.GetTile(AX, AY) * 3), Terrain)
              Case 3, 4, 5
                Call Render32(TX, TY, 4, 24, Terrain)
              Case 6 'rail system
                Call Render32(TX, TY, 4, 24, Terrain)
                'straight
                If Grid.GetTile(AX, AY) = 6 Then
                Call Render32(TX, TY, 6, 275, Terrain)
                End If
                If Grid.GetTile(AX, AY) = 7 Then
                Call Render32(TX, TY, 5, 274, Terrain)
                End If
                'curves
                If Grid.GetTile(AX, AY) = 8 Then
                Call Render32(TX, TY, 5, 273, Terrain)
                End If
                If Grid.GetTile(AX, AY) = 9 Then
                Call Render32(TX, TY, 5, 275, Terrain)
                End If
                If Grid.GetTile(AX, AY) = 10 Then
                Call Render32(TX, TY, 7, 275, Terrain)
                End If
                If Grid.GetTile(AX, AY) = 11 Then
                Call Render32(TX, TY, 7, 274, Terrain)
                End If
                'cross
                If Grid.GetTile(AX, AY) = 12 Then
                Call Render32(TX, TY, 5, 274, Terrain)
                Call Render32(TX, TY, 6, 275, Terrain)
                End If

                End Select
                            
            End If
                            
        Next
    Next
                        
    'MidLayer stuff
    For Y = 0 To 25
        For X = 0 To 22
        AX = Round(CamX) + (X - 11): AY = Round(CamY) + (Y - 11)
        TX = ((X - 1) - XOffSet) * 32: TY = ((Y - 1) - YOffSet) * 32

            If WithinBounds(AX, AY) Then
                
            Select Case Grid.GetTile(AX, AY)
            Case 3
                    With NRect
                        .Left = ((((X - 1) - XOffSet) - 2) + 0.6) * 32
                        .Top = (((Y - 1) - YOffSet) - 4) * 32
                        .Right = .Left + (4 * 32)
                        .Bottom = .Top + (5 * 32)
                    End With
                    With SrcRect
                        .Left = 0 * 32
                        .Top = 80 * 32
                        .Right = .Left + (4 * 32)
                        .Bottom = .Top + (5 * 32)
                    End With
                    Call ClipRect(NRect, SrcRect)
                    Call Draw.Surf.Blt(NRect, Terrain, SrcRect, DDBLTFAST_WAIT Or DDBLT_KEYSRC)
                    
                    If FireGrid(AX, AY) > 0 Then
                    Dim r As Long: r = 5000 - Abs(GetTick - FireGrid(AX, AY))
                    Call Render32(TX, TY, (Round((r Mod 11))), 19, Spells)
                    End If
                    
                Case 4
                    Call Render32(TX, TY, 3, 20, Terrain)
                Case 5
                    With NRect
                        .Left = (((X - 1) - XOffSet) - 0.25) * 32
                        .Top = ((Y - 1) - YOffSet) * 32
                        .Right = .Left + (2 * 32)
                        .Bottom = .Top + 32
                    End With

                    With SrcRect
                        .Left = 3 * 32
                        .Top = 59 * 32
                        .Right = .Left + (2 * 32)
                        .Bottom = .Top + 32
                    End With
                    Call ClipRect(NRect, SrcRect)
                    Call Draw.Surf.Blt(NRect, Terrain, SrcRect, DDBLTFAST_WAIT Or DDBLT_KEYSRC)
                End Select
                
                Call EntityMgr.EntityDraw(AX, AY)
                
                
                
            End If
                            
        Next
    Next

                    
    Call Draw.BltSurf
            
End Sub
